home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / ProjectOberon / Types.mod < prev    next >
Encoding:
Text File  |  1995-07-02  |  2.7 KB  |  118 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Types.mod $
  4.   Description: Clone of the Project Oberon Types module.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.1 $
  8.       $Author: fjc $
  9.         $Date: 1995/02/21 13:50:23 $
  10.  
  11.   Copyright © 1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. *************************************************************************)
  16.  
  17. <* STANDARD- *>
  18.  
  19. MODULE Types;
  20.  
  21. IMPORT SYS := SYSTEM, Kernel, Modules;
  22.  
  23. TYPE
  24.  
  25.   Type *= POINTER TO TypeDesc;
  26.   TypeDesc *= RECORD
  27.     name   *: ARRAY 32 OF CHAR;
  28.     module *: Modules.Module;
  29.     next    : Type;
  30.     tag     : SYS.TYPETAG;
  31.   END; (* TypeDesc *)
  32.  
  33. VAR
  34.  
  35.   TypList : Type;
  36.  
  37.  
  38. PROCEDURE FindType ( tag : SYS.TYPETAG ) : Type;
  39.  
  40.   VAR
  41.     module : Kernel.Module; type : Kernel.Type; t : Type;
  42.     name : ARRAY 80 OF CHAR; modName, typName : ARRAY 32 OF CHAR;
  43.     i, j : INTEGER;
  44.  
  45. BEGIN (* FindType *)
  46.   t := TypList; WHILE (t # NIL) & (t.tag # tag) DO t := t.next END;
  47.   IF t = NIL THEN
  48.     Kernel.Name (tag, name);
  49.     IF name # "" THEN
  50.       i := 0; WHILE name[i] # '.' DO modName[i] := name[i]; INC (i) END;
  51.       modName[i] := 0X;
  52.       INC (i); j := 0;
  53.       REPEAT typName[j] := name[i]; INC (i); INC (j) UNTIL name[i] = 0X;
  54.       module := Kernel.FindModule (modName);
  55.       IF module # NIL THEN
  56.         type := Kernel.FindType (module, typName);
  57.         IF type # NIL THEN
  58.           NEW (t); COPY (typName, t.name);
  59.           t.module := Modules.ThisMod(modName);
  60.           t.tag := tag; t.next := TypList; TypList := t;
  61.         END
  62.       END
  63.     END
  64.   END;
  65.   RETURN t
  66. END FindType;
  67.  
  68.  
  69. PROCEDURE BaseOf* ( t : Type; level : INTEGER ) : Type;
  70. BEGIN (* BaseOf *)
  71.   RETURN FindType (Kernel.BaseOf (t.tag, level))
  72. END BaseOf;
  73.  
  74.  
  75. PROCEDURE LevelOf* ( t : Type ) : INTEGER;
  76. BEGIN (* LevelOf *)
  77.   RETURN Kernel.LevelOf (t.tag)
  78. END LevelOf;
  79.  
  80.  
  81. PROCEDURE NewObj* ( VAR o : SYS.PTR; t : Type );
  82.  
  83.   VAR type : Kernel.Type;
  84.  
  85. BEGIN (* NewObj *)
  86.   o := NIL;
  87.   type := Kernel.FindType (Kernel.FindModule (t.module.name), t.name);
  88.   IF type # NIL THEN Kernel.New (o, type.tag) END
  89. END NewObj;
  90.  
  91.  
  92. PROCEDURE This* ( mod : Modules.Module; name : ARRAY OF CHAR ) : Type;
  93.  
  94.   VAR module : Kernel.Module; type : Kernel.Type; t : Type;
  95.  
  96. <*$ClearVars-*>
  97. BEGIN (* This *)
  98.   t := NIL; module := Kernel.FindModule (mod.name);
  99.   IF module # NIL THEN
  100.     type := Kernel.FindType (module, name);
  101.     IF type # NIL THEN
  102.       NEW (t); COPY (name, t.name);
  103.       t.module := mod; t.tag := type.tag;
  104.       t.next := TypList; TypList := t
  105.     END
  106.   END;
  107.   RETURN t
  108. END This;
  109.  
  110.  
  111. PROCEDURE TypeOf* ( o : SYS.PTR ) : Type;
  112.  
  113. BEGIN (* TypeOf *)
  114.   RETURN FindType (SYS.TAG (o))
  115. END TypeOf;
  116.  
  117. END Types.
  118.